home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2009 February / PCWFEB09.iso / Software / Linux / Kubuntu 8.10 / kubuntu-8.10-desktop-i386.iso / casper / filesystem.squashfs / usr / share / perl / 5.10.0 / strict.pm < prev    next >
Text File  |  2008-07-24  |  879b  |  47 lines
  1. package strict;
  2.  
  3. $strict::VERSION = "1.04";
  4.  
  5. # Verify that we're called correctly so that strictures will work.
  6. unless ( __FILE__ =~ /(^|[\/\\])\Q${\__PACKAGE__}\E\.pmc?$/ ) {
  7.     # Can't use Carp, since Carp uses us!
  8.     my (undef, $f, $l) = caller;
  9.     die("Incorrect use of pragma '${\__PACKAGE__}' at $f line $l.\n");
  10. }
  11.  
  12. my %bitmask = (
  13. refs => 0x00000002,
  14. subs => 0x00000200,
  15. vars => 0x00000400
  16. );
  17.  
  18. sub bits {
  19.     my $bits = 0;
  20.     my @wrong;
  21.     foreach my $s (@_) {
  22.     push @wrong, $s unless exists $bitmask{$s};
  23.         $bits |= $bitmask{$s} || 0;
  24.     }
  25.     if (@wrong) {
  26.         require Carp;
  27.         Carp::croak("Unknown 'strict' tag(s) '@wrong'");
  28.     }
  29.     $bits;
  30. }
  31.  
  32. my $default_bits = bits(qw(refs subs vars));
  33.  
  34. sub import {
  35.     shift;
  36.     $^H |= @_ ? bits(@_) : $default_bits;
  37. }
  38.  
  39. sub unimport {
  40.     shift;
  41.     $^H &= ~ (@_ ? bits(@_) : $default_bits);
  42. }
  43.  
  44. 1;
  45. __END__
  46.  
  47.